with Ada.Text_IO, Ada.Wide_Text_IO;
with v8, v8.Class_V8;
with v8.Class_Handle_Scope;
with v8.Class_Script, v8.Class_Script_Data, v8.Class_Context;
with v8.Class_Try_Catch;
with v8.Class_Value, v8.Class_String, v8.Class_Object, v8.Class_External;
with v8.Class_Date;
with v8.CLass_Message;
with v8.Class_Arguments;
with v8.Class_Number;
with v8.Class_Function_Template, v8.Class_Function;
with v8.Class_Object_Template;
with v8.Class_Primitive;
with GNAT.Calendar.Time_IO, Ada.Calendar;
with Ada.Exceptions, Ada.Unchecked_Conversion;
with System;
with System.Pool_Local;
use v8;
use type v8.double;
with Ada.Unchecked_Deallocation;
package body Examples is

   procedure Show_Result (result : v8.Class_Value.Pointer) is
   begin
      if not result.Is_Undefined then
         declare
            s       : v8.Class_String.Pointer := result.To_String;
         begin
            Ada.Wide_Text_IO.Put_Line (s.Slice);
         end;
      end if;
   end Show_Result;

   procedure Show_Stat is
      st     : v8.Heap_Statistics;
   begin
      v8.Class_V8.Get_Heap_Statistics (Statistics => st);
      Ada.Text_IO.Put_Line ("heap used : " & st.Used_Heap_Size'Img);
   end Show_Stat;

   function sum (args : v8.Class_Arguments.Arguments) return v8.Class_Value.Pointer;
   pragma Convention(CPP, sum);
   function sum (args : v8.Class_Arguments.Arguments) return v8.Class_Value.Pointer is
      x : v8.Class_Number.Pointer := args.Get (0).To_Number;
      y : v8.Class_Number.Pointer := args.Get (1).To_Number;
   begin
      return v8.Class_Value.Pointer(v8.Class_Number.Create(x.Number_Value + y.Number_Value));
   end sum;


   procedure Helloworld is
      p      : v8.Class_Handle_Scope.Handle_Scope;
      pragma Unreferenced (p);
      c      : v8.Class_Context.Handles.Persistent := v8.Class_Context.Create;
      cs     : v8.Class_Context.Scope (c.As_Object);
      ft     : v8.Class_Function.Pointer := v8.Class_Function_Template.Create (sum'Access).Get_Function;
      code   : String := "'helloworld'";
      js     : v8.Class_Script.Pointer;
   begin
      v8.Dummy_Bool := c.As_Object.Global.Set(v8.Class_String.Create (String'("sum")).As_Value, ft.As_Value);
      js := v8.Class_Script.Compile (source => v8.Class_String.Create (code));
      Show_Result (js.Run);
      c.Dispose;
   exception
      when error : others =>
         Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (error));
   end Helloworld;


   procedure Shell is
      p : v8.Class_Handle_Scope.Handle_Scope;
      pragma Unreferenced (p);

      c      : v8.Class_Context.Handles.Persistent := v8.Class_Context.Create;
      cs     : v8.Class_Context.Scope (c.As_Object);
      ver    : v8.Class_String.Pointer := v8.Class_String.Create (v8.Class_V8.Get_Version);
      tc     : v8.Class_Try_Catch.Holder;
      pragma Warnings (Off);
   begin
      loop
         Ada.Text_IO.Put("input code to execute or enter exit:");
         declare
            code : String := Ada.Text_IO.Get_Line;
            bin  : v8.Class_Script_Data.Pointer;
         begin
            exit when code = "exit";
            bin := v8.Class_Script_Data.Pre_Compile (code);
            if not bin.Has_Error then
               declare
                  js     : v8.CLass_Script.Pointer := v8.Class_Script.Compile (source => v8.Class_String.Create (code), pre_data => bin);
                  result : v8.Class_Value.Pointer := js.Run;
                  use type v8.Class_Value.Pointer;
               begin
                  if result /= null then
                     Show_Result(result);
                  else
                     Ada.Text_IO.Put_Line (int'Image(tc.Message.Get_Line_Number));
                     tc.Reset;
                  end if;
               end;
            end if;
            bin.Free;
         end;
      end loop;
   end Shell;

   package Class_Player is
      type Names is (alpha , beta);

      type Player is tagged record
         Name : Names := alpha;
      end record;
      type Pointer is access all Player;

      procedure Say (this : Player; text : Wide_String);


      procedure Free is new Ada.Unchecked_Deallocation(Player, Pointer);

   end Class_Player;

   package body Class_Player is
      procedure Say (this : Player; text : Wide_String) is
      begin
         Ada.Wide_Text_IO.Put_Line(Names'Wide_Image(this.Name) & " : " & text);
      end Say;

   end Class_Player;

   package JS_Player is
      function constructor (args : v8.Class_Arguments.Arguments) return v8.Class_Value.Pointer;
      -- when we call "new SomeObject()" in javascript
      -- v8 find v8::Value from context->global by key "SomeObject"
      --
      -- (1) if SomeObject is Object, and source ObjectTemplate has call Set_Call_As_Constructor,
      -- v8 will call the constructor to return an Object,
      -- in the constructor, we can use args.Holder to got the ObjectTemplate instance,
      -- and then do some other work on it (such as enclose an Ada Object on it)
      --
      -- (2) if SomeObject is Function,
      -- v8 will generate an Object instance (without source ObjectTemplate), set it as args.Holder
      -- we can mixin methods and properties on it,
      -- also we can enclose an Ada Object on it


      function say (args : v8.Class_Arguments.Arguments) return v8.Class_Value.Pointer;

      procedure destructor
        (Object    : v8.Class_Value.Handles.Persistent;
         Parameter : System.Address);

      procedure Register (context : v8.Class_Context.Pointer);

      pragma Convention (CPP, constructor);
      pragma Convention(CPP, destructor);
      pragma Convention(CPP, say);

   end JS_Player;

   package body JS_Player is
      function Extract is new v8.Class_External.Value (Class_Player.Player, Class_Player.Pointer);
      function Enclose is new v8.Class_External.Create (Class_Player.Player, Class_Player.Pointer);


      function say (args : v8.Class_Arguments.Arguments) return v8.Class_Value.Pointer is
         js_text : v8.Class_String.Pointer := args.Get (0).To_String;
         ada_text : Wide_String := js_text.Slice;
         ada_this : Class_Player.Pointer := Extract(v8.Class_External.Cast(args.Holder.Get_Internal_Field (0)));
      begin
         ada_this.Say (ada_text);
         return v8.Class_Value.Pointer(v8.Class_Primitive.Constant_Undefined);
      end say;

      function constructor (args : v8.Class_Arguments.Arguments) return v8.Class_Value.Pointer is
         js_this  : v8.Class_Object.Pointer := args.Holder;
         ada_this : Class_Player.Pointer := new Class_Player.Player;
         p        : v8.Class_Value.Handles.Persistent;
         use type v8.int32_t;
      begin
         if args.Length > 0 then
            declare
               js_this_name : v8.Class_String.Pointer := args.Get (0).To_String;
            begin
               ada_this.Name := Class_Player.Names'Wide_Value(js_this_name.Slice);
            end;
         end if;
         js_this.Set_Internal_Field (0, Enclose (ada_this).As_Value);
         Ada.Text_IO.Put_Line ("Player is created");
         p := v8.Class_Value.Handles.Class_Persistent.Create (js_this.As_Value);
         p.Make_Weak (callback => destructor'Access);
         p.Mark_Independent;
         return p.As_Object;
      end constructor;

      procedure destructor
        (Object    : v8.Class_Value.Handles.Persistent;
         Parameter : System.Address)
      is
      begin
         Ada.Text_IO.Put_Line("Player is destroying");
      end destructor;


      procedure Register (context : v8.Class_Context.Pointer) is
         g : v8.Class_Object.Pointer := context.Global;

         tempalete      : v8.Class_Object_Template.Pointer := v8.Class_Object_Template.Create;
         class_name     : v8.Class_String.Pointer := v8.Class_String.Create (String'("Player"));
         method_name    : v8.Class_String.Pointer := v8.Class_String.Create (String'("say"));
         method_entry   : v8.Class_Function.Pointer := v8.Class_Function_Template.Create (say'Access).Get_Function;
      begin
         tempalete.Set (method_name, method_entry.As_Data);
         tempalete.Set_Internal_Field_Count (1);
         tempalete.Set_Call_As_Function_Handler (constructor'Access);
         Dummy_Bool := g.Set (class_name.As_Value, tempalete.New_Instance.As_Value);
         Ada.Text_IO.Put_Line("Player is registered");
      end Register;
   end JS_Player;



   procedure Test_External is
      p      : v8.Class_Handle_Scope.Handle_Scope;
      pragma Unreferenced (p);
      c      : v8.Class_Context.Handles.Persistent := v8.Class_Context.Create;
      cs     : v8.Class_Context.Scope (c.As_Object);
      code   : String := "(new Player('beta')).say('hello,world');";
      js     : v8.Class_Script.Pointer;

   begin
      JS_Player.Register (c.As_Object);
      Show_Stat;
      js := v8.Class_Script.Compile (source => v8.Class_String.Create (code));
      Show_Stat;
      Show_Result (js.Run);
      Show_Stat;
      v8.Class_V8.Low_Memory_Notification;
      Show_Stat;
      c.Dispose;
   exception
      when error : others =>
         Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (error));
   end Test_External;

end Examples;
